Analyses

Non preregistered analyses - alternative Bayesian metaanalytic models

The original preregistration for the studies contained both hypotheses and the specific analytic strategies that would be used to test them. However, these preregistrations did not include a meta-analytic strategy. Separately, a number of research questions/hypotheses were generated from exploration of the data from Experiments 1-6 that were not contained in the original preregistration, or where the specific analytic strategy to test them was not precisely specified or difficult to interpret. Separately, some methodological improvements were thought of after Experiments 1-6 was run (e.g., improved exclusion criteria to ensure participants stayed on the page where they watched/listened to the intervention in its entirety). We therefore elected to use the data from Experiments 1-6 to create this (non-preregistered) alternative analytic strategy that formalized our core research questions, hypotheses, analytic models, inference rules, and other researcher degrees of freedom. This analytic strategy (and code to implement it) will be preregistered for Experiment 7 which will provide strong confirmatory tests of these hypotheses.

Dependencies & functions

# dependencies
library(tidyverse)
library(knitr)
library(kableExtra)
library(brms)
library(parallel)
library(tidybayes)
library(bayestestR)
library(sjPlot)
library(psych)
library(rsample)
library(broom)
library(purrr)
library(IATscores)
library(lavaan)
library(semTools)
library(modelr)
library(furrr)
library(caret)
library(e1071)

# set up parallel processing
future::plan(multiprocess)

# knitr options
options(knitr.kable.NA = "/")

# set seed for bootstrapping reproducibility
set.seed(42)

# create necessary folder
dir.create("models")

Exclusions & standaridization

All dependent variables (self-reported ratings, IAT D2 scores, behavioral intentions) were standardized (by 1 SD) after exclusions and prior to analysis condition (see Lorah, 2018: https://doi.org/10.1186/s40536-018-0061-2). This was done within each level of both IV (i.e., by Source Valence condition [positive vs. negative], and by Video Content [Genuine vs. Deepfaked]). As such, the beta estimates obtained from the Bayesian models (see research questions and data analysis plans below) therefore represent standardized beta values (\(\beta\) rather than \(B\)). More importantly, the nature of this standardization makes these estimates somewhat comparable to the frequentist standardized effect size metric Cohen’s \(d\), as both are a differences in (estimated) means as a proportion of SD although they should not be treated as equivalent. Effect size magnitude here can therefore be thought of along comparable scales as Cohen’s \(d\). As such, to aid interpretability, the point estimates of effect size will be reported as \(\delta\) (delta).

# full data
data_processed <- read.csv("../data/processed/4_data_participant_level_with_hand_scoring.csv") %>%
  # include only experiments 1-6
  filter(experiment %in% c(1, 2, 3, 4, 5, 6)) %>%
  # set factor levels for t test comparisons
  mutate(source_valence = fct_relevel(source_valence,
                                      "negative",
                                      "positive"),
         experiment_condition = fct_relevel(experiment_condition,
                                            "genuine",
                                            "deepfaked"),
         experiment = as.factor(experiment))

# apply exclusions
data_after_exclusions <- data_processed %>%
  filter(exclude_subject == FALSE & 
           exclude_implausible_intervention_linger == FALSE) %>%
  # standardize DVs by 1SD within each experiment and their conditions
  group_by(experiment, experiment_condition, source_valence) %>%
  mutate(mean_self_reported_evaluation = mean_self_reported_evaluation/sd(mean_self_reported_evaluation),
         IAT_D2 = IAT_D2/sd(IAT_D2),
         mean_intentions = mean_intentions/sd(mean_intentions)) %>%
  ungroup()

# item level for iat
data_iat_item_level_after_exclusions <- read_csv("../data/processed/2.4_data_iat_item_level.csv") %>%
  # exclude the same participants as above
  semi_join(rename(data_after_exclusions, subject_original = subject), by = "subject_original") 

Distributions

ggplot(data_after_exclusions, aes(mean_self_reported_evaluation, color = experiment)) +
  geom_density() +
  facet_wrap( ~ experiment_condition + source_valence) +
  ggtitle("Standardized scores")

ggplot(data_after_exclusions, aes(IAT_D2, color = experiment)) +
  geom_density() +
  facet_wrap( ~ experiment_condition + source_valence) +
  ggtitle("Standardized scores")

ggplot(data_after_exclusions, aes(mean_intentions, color = experiment)) +
  geom_density() +
  facet_wrap( ~ experiment_condition + source_valence) +
  ggtitle("Standardized scores")

Demographics

Pre exclussion

data_processed %>%
  group_by(experiment) %>%
  summarise(n = n(),
            excluded_n = sum(exclude_subject > 0 | exclude_implausible_intervention_linger > 0),
            excluded_percent = (excluded_n / n) *100) %>%
  mutate_if(is.numeric, round, digits = 1) %>%
  kable(align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

experiment	n	excluded_n	excluded_percent
1	165	24	14.5
2	167	36	21.6
3	428	91	21.3
4	429	106	24.7
5	276	66	23.9
6	265	61	23.0

Post exclusions

data_after_exclusions %>%
  group_by(experiment) %>%
  summarise(n = n(),
            age_mean = mean(age, na.rm = TRUE),
            age_sd = sd(age, na.rm = TRUE)) %>%
  mutate_if(is.numeric, round, digits = 1) %>%
  kable(align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

experiment	n	age_mean	age_sd
1	141	29.7	7.6
2	131	31.1	7.3
3	337	29.8	8.7
4	323	30.1	9.0
5	210	31.2	11.5
6	204	33.3	12.5

data_after_exclusions %>%
  count(experiment, gender) %>%
  spread(gender, n) %>%
  kable(knitr.kable.NA = "/", align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

experiment	female	male	Non-binary	other	Prefer not to disclose
1	67	73	/	1	/
2	76	55	/	/	/
3	184	149	/	4	/
4	189	132	/	2	/
5	119	88	2	/	1
6	120	82	2	/	/

Internal consistency

Self-reported evaluations

model_sr <- "scale =~ ratings_bad_good + ratings_dislike_like + ratings_negative_positive" 

fit_cfa_sr <- data_after_exclusions %>%
  cfa(model = model_sr, data = .) 

results_reliability_sr <- fit_cfa_sr %>%
  reliability() %>%
  as.data.frame() %>%
  rownames_to_column(var = "metric") %>%
  select(metric, estimate = scale) %>%
  filter(metric %in% c("alpha",
                       "omega2")) %>%
  mutate(metric = recode(metric,
                         "alpha" = "alpha",
                         "omega2" = "omega_t"),
         estimate = round(estimate, 3))

results_reliability_sr %>%
  kable(knitr.kable.NA = "/", align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

metric	estimate
alpha	0.987
omega_t	0.987

IAT

split half

results_iat_split_half_reliability <- data_iat_item_level_after_exclusions %>%
  SplitHalf.D2(IATdata = .) %>%
  mutate(algorithm = ifelse(algorithm == "p2112", "D2", algorithm),
         splithalf = round(splithalf, 3))

## [1] "2020-12-08 22:38:36: Applying parameter P4 = dist"
## [1] "2020-12-08 22:38:36: Applying parameters P1 and P2"
## [1] "2020-12-08 22:38:36: Applying parameter P3 = dscore"
## [1] "2020-12-08 22:38:37: Applying parameters P1 and P2"
## [1] "2020-12-08 22:38:37: Applying parameter P3 = dscore"
## [1] "2020-12-08 22:38:38: IAT scores have been computed"
## [1] "2020-12-08 22:38:38: Applying parameter P4 = dist"
## [1] "2020-12-08 22:38:38: Applying parameters P1 and P2"
## [1] "2020-12-08 22:38:38: Applying parameter P3 = dscore"
## [1] "2020-12-08 22:38:39: Applying parameters P1 and P2"
## [1] "2020-12-08 22:38:39: Applying parameter P3 = dscore"
## [1] "2020-12-08 22:38:40: IAT scores have been computed"

results_iat_split_half_reliability %>%
  kable(knitr.kable.NA = "/", align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

algorithm	splithalf
D2	0.839

Behavioral intentions

model_bi <- "scale =~ behavioral_intentions_share + behavioral_intentions_subscribe + behavioral_intentions_recommend" 

fit_cfa_bi <- data_after_exclusions %>%
  cfa(model = model_bi, data = .) 

results_reliability_bi <- fit_cfa_bi %>%
  reliability() %>%
  as.data.frame() %>%
  rownames_to_column(var = "metric") %>%
  select(metric, estimate = scale) %>%
  filter(metric %in% c("alpha",
                       "omega2")) %>%
  mutate(metric = recode(metric,
                         "alpha" = "alpha",
                         "omega2" = "omega_t"),
         estimate = round(estimate, 3))

results_reliability_bi %>%
  kable(knitr.kable.NA = "/", align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

metric	estimate
alpha	0.941
omega_t	0.941

RQ1 & RQ2: Can online content establish first impressions towards a novel individual?; Are Deepfakes just as good as genuine online content at establishing first impressions?

• Analyses employ Bayesian multilevel models with experiment employed as a random (Group level) intercept, and source_valence, experiment_condition and their interaction as IVs. This could therefore be described as akin to a Bayesian multilevel ANOVA.
• DVs were standardize as noted above, and as such fitted model estimates represent standardized beta values (which due to the specifics of the standardization have comparable [but not exact] interpretation as Cohen’s d values).
• Bayesian p values are also reported: these are on a similar scale to frequentist p values, but technically are 1 minus the posterior probability that the effect is greater than 0, i.e., \(1 - P(\beta>0)\).
• Inspection of the posterior distributions allow us to infer that we employed weak priors placed on all parameters (normal distribution with M = 0 and SD = 10). Inspection of the chains indicated good convergence in all cases.

H1 hypotheses were tested using a Bayesian linear model to estimate a 95% Credible Interval on standardized effect size change in evaluations between Source Valence conditions. Credible Intervals whose lower bounds were > 0 were considered evidence in support of a given hypothesis.

For H2, if the lower bound of the 95% CI of the genuine condition is < the lower bound of the 90% CI of the Deepfaked condition (i.e., the difference between Source Valence conditions in each subgroups), this as considered evidence in support of the alternative hypothesis (i.e., evidence of non-inferiority in estimated means; that Deepfakes are as good as genuine content).

Sample sizes

data_after_exclusions %>%
  select(source_valence, 
         experiment_condition) %>%
  drop_na() %>%
  count(experiment_condition,
        source_valence) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

experiment_condition	source_valence	n
genuine	negative	382
genuine	positive	425
deepfaked	negative	257
deepfaked	positive	282

Self-reported evaluations

Fit model

fit_exploratory_selfreport <-
  brm(formula = mean_self_reported_evaluation ~ source_valence * experiment_condition + (1 | experiment),
      family = gaussian(),
      data    = data_after_exclusions,
      file    = "models/fit_exploratory_selfreport",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_exploratory_selfreport)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_self_reported_evaluation ~ source_valence * experiment_condition + (1 | experiment) 
##    Data: data_after_exclusions (Number of observations: 1346) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Group-Level Effects: 
## ~experiment (Number of levels: 6) 
##               Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept)     0.18      0.11     0.06     0.45 1.00     6062    10346
## 
## Population-Level Effects: 
##                                                      Estimate Est.Error
## Intercept                                               -1.48      0.10
## source_valencepositive                                   2.71      0.07
## experiment_conditiondeepfaked                            0.08      0.09
## source_valencepositive:experiment_conditiondeepfaked     0.01      0.12
##                                                      l-95% CI u-95% CI Rhat
## Intercept                                               -1.67    -1.28 1.00
## source_valencepositive                                   2.56     2.85 1.00
## experiment_conditiondeepfaked                           -0.09     0.25 1.00
## source_valencepositive:experiment_conditiondeepfaked    -0.22     0.23 1.00
##                                                      Bulk_ESS Tail_ESS
## Intercept                                                9436    10696
## source_valencepositive                                  16185    19241
## experiment_conditiondeepfaked                           15506    17346
## source_valencepositive:experiment_conditiondeepfaked    14095    17133
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.03      0.02     1.00     1.07 1.00    22984    19026
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_exploratory_selfreport, ask = FALSE)

Check informativeness of prior

Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.

check_prior(fit_exploratory_selfreport) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative
b_experiment_conditiondeepfaked	uninformative
b_source_valencepositive.experiment_conditiondeepfaked	uninformative

Interpret posteriors

# plot_model(fit_exploratory_selfreport)
plot_model(fit_exploratory_selfreport, type = "pred", terms = c("source_valence", "experiment_condition"))

# percent moderation
draws_sr <-
  bind_cols(
    select(spread_draws(fit_exploratory_selfreport, b_source_valencepositive), b_source_valencepositive),
    select(spread_draws(fit_exploratory_selfreport, b_experiment_conditiondeepfaked), b_experiment_conditiondeepfaked),
    select(spread_draws(fit_exploratory_selfreport, `b_source_valencepositive:experiment_conditiondeepfaked`), `b_source_valencepositive:experiment_conditiondeepfaked`)
  ) %>%
  rename(main_valence = b_source_valencepositive,
         main_experiment_condition = b_experiment_conditiondeepfaked,
         interaction = `b_source_valencepositive:experiment_conditiondeepfaked`) %>%
  mutate(effect_genuine = main_valence,
         effect_deepfaked = main_valence + interaction,
         #percent_moderation = (main_experiment_condition + interaction)/main_valence *100,  # alt method, same result
         percent_comparison = (effect_deepfaked/effect_genuine)*100)

# results
estimates_sr <-
  map_estimate(draws_sr) %>%
  full_join(bayestestR::hdi(draws_sr, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_sr, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_sr %>%
              select(-percent_comparison) %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
         CI_90_lower, CI_90_upper, p)

# results table
estimates_sr %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
main_valence	2.71	2.57	2.85	2.58	2.82	0.0000000
main_experiment_condition	0.08	-0.09	0.25	-0.06	0.22	0.1792857
interaction	0.02	-0.21	0.24	-0.19	0.19	0.4719286
effect_genuine	2.71	2.57	2.85	2.58	2.82	0.0000000
effect_deepfaked	2.71	2.53	2.88	2.57	2.86	0.0000000
percent_comparison	100.45	92.14	108.84	93.42	107.40	/

# hypothesis testing
H1a <- ifelse((estimates_sr %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H1b <- ifelse((estimates_sr %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H2a <- ifelse((estimates_sr %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_90_lower)) > 
                (estimates_sr %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)), 
              "Accepted", "Rejected")

comparison_string_sr <-
  paste0("Deepfakes are ",
         estimates_sr %>% filter(Parameter == "percent_comparison") %>% pull(MAP_Estimate) %>% round(1),
         "% (95% CI [",
         estimates_sr %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_lower) %>% round(1),
         ", ",
         estimates_sr %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_upper) %>% round(1),
         "]) as effective as genuine content in establishing self-reported evaluations")

H1a

The content of the genuine videos (i.e., Source Valence) will influence participants’ self-reported evaluations.

• Result: Accepted

H1b

The content of the Deepfaked videos (i.e., Source Valence) will influence participants’ self-reported evaluations.

• Result: Accepted

H2a

Change in self-reported evaluations (i.e., between Source Valence conditions) induced by Deepfaked video content will be non-inferior to genuine content.

• Result: Accepted. Deepfakes are 100.4% (95% CI [92.1, 108.8]) as effective as genuine content in establishing self-reported evaluations.

Implicit

Fit model

fit_exploratory_implicit <-
  brm(formula = IAT_D2 ~ source_valence * experiment_condition + (1 | experiment),
      family = gaussian(),
      data    = data_after_exclusions,
      file    = "models/fit_exploratory_implicit",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_exploratory_implicit)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: IAT_D2 ~ source_valence * experiment_condition + (1 | experiment) 
##    Data: data_after_exclusions (Number of observations: 1346) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Group-Level Effects: 
## ~experiment (Number of levels: 6) 
##               Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept)     0.20      0.11     0.07     0.49 1.00     6353    10078
## 
## Population-Level Effects: 
##                                                      Estimate Est.Error
## Intercept                                                0.05      0.11
## source_valencepositive                                   1.32      0.07
## experiment_conditiondeepfaked                            0.07      0.08
## source_valencepositive:experiment_conditiondeepfaked     0.00      0.11
##                                                      l-95% CI u-95% CI Rhat
## Intercept                                               -0.16     0.26 1.00
## source_valencepositive                                   1.19     1.46 1.00
## experiment_conditiondeepfaked                           -0.10     0.24 1.00
## source_valencepositive:experiment_conditiondeepfaked    -0.22     0.22 1.00
##                                                      Bulk_ESS Tail_ESS
## Intercept                                                8577    10726
## source_valencepositive                                  16062    17724
## experiment_conditiondeepfaked                           14240    17618
## source_valencepositive:experiment_conditiondeepfaked    13767    17652
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.00      0.02     0.97     1.04 1.00    21681    19247
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_exploratory_implicit, ask = FALSE)

Check informativeness of prior

Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.

check_prior(fit_exploratory_implicit) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative
b_experiment_conditiondeepfaked	uninformative
b_source_valencepositive.experiment_conditiondeepfaked	uninformative

Interpret posteriors

#plot_model(fit_exploratory_implicit)
plot_model(fit_exploratory_implicit, type = "pred", terms = c("source_valence", "experiment_condition"))

# percent moderation
draws_imp <-
  bind_cols(
    select(spread_draws(fit_exploratory_implicit, b_source_valencepositive), b_source_valencepositive),
    select(spread_draws(fit_exploratory_implicit, b_experiment_conditiondeepfaked), b_experiment_conditiondeepfaked),
    select(spread_draws(fit_exploratory_implicit, `b_source_valencepositive:experiment_conditiondeepfaked`), `b_source_valencepositive:experiment_conditiondeepfaked`)
  ) %>%
  rename(main_valence = b_source_valencepositive,
         main_experiment_condition = b_experiment_conditiondeepfaked,
         interaction = `b_source_valencepositive:experiment_conditiondeepfaked`) %>%
  mutate(effect_genuine = main_valence,
         effect_deepfaked = main_valence + interaction,
         #percent_moderation = (main_experiment_condition + interaction)/main_valence *100,  # alt method, same result
         percent_comparison = (effect_deepfaked/effect_genuine)*100)

# results table
estimates_imp <-
  map_estimate(draws_imp) %>%
  full_join(bayestestR::hdi(draws_imp, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_imp, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_imp %>%
              select(-percent_comparison) %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
         CI_90_lower, CI_90_upper, p)

estimates_imp %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
main_valence	1.33	1.19	1.46	1.21	1.44	0.0000000
main_experiment_condition	0.07	-0.10	0.23	-0.07	0.21	0.2023571
interaction	0.01	-0.22	0.22	-0.18	0.18	0.4975000
effect_genuine	1.33	1.19	1.46	1.21	1.44	0.0000000
effect_deepfaked	1.32	1.16	1.49	1.18	1.47	0.0000000
percent_comparison	100.28	83.91	117.07	86.13	113.81	/

# hypothesis testing
H1c <- ifelse((estimates_imp %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H1d <- ifelse((estimates_imp %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H2b <- ifelse((estimates_imp %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_90_lower)) > 
                (estimates_imp %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)), 
              "Accepted", "Rejected")

comparison_string_imp <-
  paste0("Deepfakes are ",
         estimates_imp %>% filter(Parameter == "percent_comparison") %>% pull(MAP_Estimate) %>% round(1), 
         "% (95% CI [",
         estimates_imp %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_lower) %>% round(1),
         ", ",
         estimates_imp %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_upper) %>% round(1),
         "]) as effective as genuine content in establishing self-reported evaluations")

H1c

The content of the genuine videos (i.e., Source Valence) will influence participants’ IAT D2 scores.

• Result: Accepted

H1d

The content of the Deepfaked videos (i.e., Source Valence) will influence participants’ IAT D2 scores.

• Result: Accepted

H2b

Change in IAT D2 scores (i.e., between Source Valence conditions) induced by Deepfaked video content will be non-inferior to genuine content.

• Result: Rejected. Deepfakes are 100.3% (95% CI [83.9, 117.1]) as effective as genuine content in establishing self-reported evaluations.

Behavioural intentions

Fit model

fit_exploratory_intentions <-
  brm(formula = mean_intentions ~ source_valence * experiment_condition, # no random effect for experiment as only exp 6 assessed intentions
      family = gaussian(),
      data    = data_after_exclusions,
      file    = "models/fit_exploratory_intentions",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_exploratory_intentions)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_intentions ~ source_valence * experiment_condition 
##    Data: data_after_exclusions (Number of observations: 204) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                                                      Estimate Est.Error
## Intercept                                               -1.63      0.14
## source_valencepositive                                   1.12      0.20
## experiment_conditiondeepfaked                           -1.70      0.21
## source_valencepositive:experiment_conditiondeepfaked     1.95      0.28
##                                                      l-95% CI u-95% CI Rhat
## Intercept                                               -1.92    -1.35 1.00
## source_valencepositive                                   0.72     1.52 1.00
## experiment_conditiondeepfaked                           -2.11    -1.30 1.00
## source_valencepositive:experiment_conditiondeepfaked     1.40     2.51 1.00
##                                                      Bulk_ESS Tail_ESS
## Intercept                                               13302    17373
## source_valencepositive                                  11324    15341
## experiment_conditiondeepfaked                           11304    15274
## source_valencepositive:experiment_conditiondeepfaked     9888    13384
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.01      0.05     0.91     1.11 1.00    21248    18591
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_exploratory_intentions, ask = FALSE)

Check informativeness of prior

Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.

check_prior(fit_exploratory_intentions) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative
b_experiment_conditiondeepfaked	uninformative
b_source_valencepositive.experiment_conditiondeepfaked	uninformative

Interpret posteriors

#plot_model(fit_exploratory_intentions)
plot_model(fit_exploratory_intentions, type = "pred", terms = c("source_valence", "experiment_condition"))

# percent moderation
draws_intentions <-
  bind_cols(
    select(spread_draws(fit_exploratory_intentions, b_source_valencepositive), b_source_valencepositive),
    select(spread_draws(fit_exploratory_intentions, b_experiment_conditiondeepfaked), b_experiment_conditiondeepfaked),
    select(spread_draws(fit_exploratory_intentions, `b_source_valencepositive:experiment_conditiondeepfaked`), `b_source_valencepositive:experiment_conditiondeepfaked`)
  ) %>%
  rename(main_valence = b_source_valencepositive,
         main_experiment_condition = b_experiment_conditiondeepfaked,
         interaction = `b_source_valencepositive:experiment_conditiondeepfaked`) %>%
  mutate(effect_genuine = main_valence,
         effect_deepfaked = main_valence + interaction,
         #percent_moderation = (main_experiment_condition + interaction)/main_valence *100,  # alt method, same result
         percent_comparison = (effect_deepfaked/effect_genuine)*100)

# results table
estimates_intentions <-
  map_estimate(draws_intentions) %>%
  full_join(bayestestR::hdi(draws_intentions, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_intentions, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_intentions %>%
              select(-percent_comparison) %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
         CI_90_lower, CI_90_upper, p)

estimates_intentions %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
main_valence	1.08	0.72	1.52	0.78	1.45	0
main_experiment_condition	-1.71	-2.10	-1.30	-2.04	-1.37	0
interaction	1.97	1.40	2.51	1.49	2.42	0
effect_genuine	1.08	0.72	1.52	0.78	1.45	0
effect_deepfaked	3.08	2.69	3.46	2.76	3.40	0
percent_comparison	256.76	184.75	406.12	194.97	374.57	/

# hypothesis testing
H1e <- ifelse((estimates_intentions %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H1f <- ifelse((estimates_intentions %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H2c <- ifelse((estimates_intentions %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_90_lower)) > 
                (estimates_intentions %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)), 
              "Accepted", "Rejected")

comparison_string_intentions <-
  paste0("Deepfakes are ",
         estimates_intentions %>% filter(Parameter == "percent_comparison") %>% pull(MAP_Estimate) %>% round(1), 
         "% (95% CI [",
         estimates_intentions %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_lower) %>% round(1),
         ", ",
         estimates_intentions %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_upper) %>% round(1),
         "]) as effective as genuine content in establishing self-reported evaluations")

H1e

The content of the genuine videos (i.e., Source Valence) will influence participants’ behavioral intention responses.

• Result: Accepted

H1f

The content of the Deepfaked videos (i.e., Source Valence) will influence participants’ behavioral intention responses.

• Result: Accepted

H2c

Change in behavioral intentions (i.e., between Source Valence conditions) induced by Deepfaked video content will be non-inferior to genuine content.

• Result: Accepted. Deepfakes are 256.8% (95% CI [184.8, 406.1]) as effective as genuine content in establishing self-reported evaluations.

RQ3: How good are people at detecting Deepfakes?

Inter-rater relibility

data_after_exclusions %>%
  count(deepfake_detection_open_recoded,
        deepfake_detection_rater_1,
        deepfake_detection_rater_2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

deepfake_detection_open_recoded	deepfake_detection_rater_1	deepfake_detection_rater_2	n
FALSE	FALSE	FALSE	414
FALSE	FALSE	TRUE	16
FALSE	TRUE	FALSE	31
TRUE	TRUE	TRUE	115
/	/	/	770

data_after_exclusions %>%
  summarize(percent_agreement = round(mean(deepfake_detection_rater_1 == deepfake_detection_rater_2, na.rm = TRUE)*100, 1)) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

percent_agreement
91.8

data_after_exclusions %>%
  select(deepfake_detection_rater_1,                                   
         deepfake_detection_rater_2) %>%
  as.data.frame() %>%  # kappa function won't take tibbles
  psych::cohen.kappa(.)

## Call: cohen.kappa1(x = x, w = w, n.obs = n.obs, alpha = alpha, levels = levels)
## 
## Cohen Kappa and Weighted Kappa correlation coefficients and confidence boundaries 
##                  lower estimate upper
## unweighted kappa  0.72     0.78  0.84
## weighted kappa    0.72     0.78  0.84
## 
##  Number of subjects = 576

Interpretation of Kappa (Altman 1999, Landis JR, 1977):

• 0.61 - 0.80 Substantial
• 0.81 - 1.00 Almost perfect

Can people accurately detect deepfakes?

• Youden’s J = sensitivity + specificity - 1, aka informedness, aka “the probability of an informed decision (as opposed to a random guess) and takes into account all predictions”
• 95% CIs were bootstrapped via case removal and the percentile method.

Sample size

data_after_exclusions %>%
  count(experiment_condition,
        deepfake_detection_open_recoded) %>%
  drop_na() %>%
  mutate(deepfake_detection_open_recoded = case_when(deepfake_detection_open_recoded == "TRUE" ~ "deepfaked",
                                                     deepfake_detection_open_recoded == "FALSE" ~ "genuine")) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

experiment_condition	deepfake_detection_open_recoded	n
genuine	genuine	188
genuine	deepfaked	16
deepfaked	genuine	273
deepfaked	deepfaked	99

Classification stats

data_classifications <- data_after_exclusions %>%
  select(experiment_condition, deepfake_detection_open_recoded) %>%
  drop_na() %>%
  mutate(deepfake_detection_open_recoded = case_when(deepfake_detection_open_recoded == "TRUE" ~ "deepfaked",
                                                     deepfake_detection_open_recoded == "FALSE" ~ "genuine"))

truth <- factor(data_classifications$experiment_condition,
                levels = rev(c("genuine", "deepfaked")))

pred <- factor(data_classifications$deepfake_detection_open_recoded,
               levels = rev(c("genuine", "deepfaked")))

cm <- confusionMatrix(table(pred, truth))

fit_confirmatory_classification <-
  as_tibble(cm$byClass, rownames = "parameter") %>%
  spread(parameter, value) %>%
  mutate(balanced_accuracy = `Balanced Accuracy`,
         false_negative_rate = 1 - Sensitivity,
         false_positive_rate = 1 - Specificity,
         informedness = Sensitivity + Specificity - 1) %>%
  select(balanced_accuracy,
         informedness,
         false_negative_rate,
         false_positive_rate) %>%
  gather(variable, observed, c(balanced_accuracy, 
                               informedness, 
                               false_negative_rate, 
                               false_positive_rate))

Bootstrapped classification stats

# create bootstraps using out of bag method. makes a df with values that are collapsed dfs.
boots <- data_classifications %>%
  bootstraps(times = 2000)

# function to bootstrap classification stats and return a tibble
bootstrap_categorization_stats <- function(split) {
  
  truth <- factor(analysis(split)$experiment_condition,
                  levels = rev(c("genuine", "deepfaked")))
  
  pred <- factor(analysis(split)$deepfake_detection_open_recoded,
                 levels = rev(c("genuine", "deepfaked")))
  
  cm <- confusionMatrix(table(pred, truth))
  
  results <-
    as_tibble(cm$byClass, rownames = "parameter") %>%
    spread(parameter, value) %>%
    mutate(balanced_accuracy = `Balanced Accuracy`,
           false_negative_rate = 1 - Sensitivity,
           false_positive_rate = 1 - Specificity,
           informedness = Sensitivity + Specificity - 1) %>%
    select(balanced_accuracy,
           informedness,
           false_negative_rate,
           false_positive_rate) 
  
  return(results)
}

# apply to each bootstrap
fit_confirmatory_classification_bootstraps <- boots %>%
  mutate(categorization_stats = future_map(splits, bootstrap_categorization_stats)) %>%
  select(-splits) %>%
  unnest(categorization_stats)

Results

classifications <- fit_confirmatory_classification_bootstraps %>%
  gather(variable, value, c(balanced_accuracy, 
                            informedness, 
                            false_negative_rate, 
                            false_positive_rate)) %>%
  group_by(variable) %>%
  summarize(ci_lower = quantile(value, 0.025),
            ci_upper = quantile(value, 0.975),
            .groups  = "drop") %>%
  full_join(fit_confirmatory_classification, by = "variable") %>%
  mutate_if(is.numeric, round, digits = 2) %>%
  select(variable, observed, ci_lower, ci_upper) 

classifications %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)

variable	observed	ci_lower	ci_upper
balanced_accuracy	0.59	0.56	0.62
false_negative_rate	0.73	0.69	0.78
false_positive_rate	0.08	0.04	0.12
informedness	0.19	0.13	0.25

H3: Participants are poor at making accurate and informed judgements about whether online video content is genuine or Deepfaked. Our predictions here are descriptive/continuous rather than involving cut-off based inference rules.

• H3a. We expect a substantial proportion of participants to be poor at correctly detecting Deepfakes. This will be examined using the false negative rate, although we do not have numerical predictions here.
• H3b. We expect a substantial proportion of participants to incorrectly detect Deepfakes even when the video content was real/.This will be examined using the false positive rate, although we do not have numerical predictions here.
• H3c. We expect participants to be poor at making accurate decisions about whether content is genuine or not (e.g., Balanced Accuracy not greatly above chance, circa .60), far less than what might be considered highly accurate decisions (e.g., BA of .80 or .90).
• H3d. We expect participants to make poorly informed decisions about whether content is genuine or not, (e.g., informedness/Youden’s J of circa .20), far less than what might be considered highly informed decisions (e.g., J of .80 or .90).

Even the subset of participants who were aware of the concept of Deepfakes before the study?

Same descriptive predictions as above.

Sample size

data_after_exclusions %>%
  filter(deepfake_awareness_open_recoded == TRUE) %>%
  count(experiment_condition,
        deepfake_detection_open_recoded) %>%
  drop_na() %>%
  mutate(deepfake_detection_open_recoded = case_when(deepfake_detection_open_recoded == "TRUE" ~ "deepfaked",
                                                     deepfake_detection_open_recoded == "FALSE" ~ "genuine")) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

experiment_condition	deepfake_detection_open_recoded	n
genuine	genuine	96
genuine	deepfaked	10
deepfaked	genuine	82
deepfaked	deepfaked	32

Classification stats

data_classifications_subset <- data_after_exclusions %>%
  filter(deepfake_awareness_open_recoded == TRUE) %>%
  select(experiment_condition, deepfake_detection_open_recoded) %>%
  drop_na() %>%
  mutate(deepfake_detection_open_recoded = case_when(deepfake_detection_open_recoded == "TRUE" ~ "deepfaked",
                                                     deepfake_detection_open_recoded == "FALSE" ~ "genuine"))

truth_subset <- factor(data_classifications_subset$experiment_condition,
                levels = rev(c("genuine", "deepfaked")))

pred_subset <- factor(data_classifications_subset$deepfake_detection_open_recoded,
               levels = rev(c("genuine", "deepfaked")))

cm_subset <- confusionMatrix(table(pred_subset, truth_subset))

fit_confirmatory_classification_subset <-
  as_tibble(cm_subset$byClass, rownames = "parameter") %>%
  spread(parameter, value) %>%
  mutate(balanced_accuracy = `Balanced Accuracy`,
         false_negative_rate = 1 - Sensitivity,
         false_positive_rate = 1 - Specificity,
         informedness = Sensitivity + Specificity - 1) %>%
  select(balanced_accuracy,
         informedness,
         false_negative_rate,
         false_positive_rate) %>%
  gather(variable, observed, c(balanced_accuracy, 
                               informedness, 
                               false_negative_rate, 
                               false_positive_rate))

Bootstrapped classification stats

# create bootstraps using out of bag method. makes a df with values that are collapsed dfs.
boots_subset <- data_classifications_subset %>%
  bootstraps(times = 2000)

# apply to each bootstrap
fit_confirmatory_classification_bootstraps_subset <- boots_subset %>%
  mutate(categorization_stats = future_map(splits, bootstrap_categorization_stats)) %>%
  select(-splits) %>%
  unnest(categorization_stats)

Results

classifications_subset <- fit_confirmatory_classification_bootstraps_subset %>%
  gather(variable, value, c(balanced_accuracy, 
                            informedness, 
                            false_negative_rate, 
                            false_positive_rate)) %>%
  group_by(variable) %>%
  summarize(ci_lower = quantile(value, 0.025),
            ci_upper = quantile(value, 0.975),
            .groups  = "drop") %>%
  full_join(fit_confirmatory_classification_subset, by = "variable") %>%
  mutate_if(is.numeric, round, digits = 2) %>%
  select(variable, observed, ci_lower, ci_upper) 

classifications_subset %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)

variable	observed	ci_lower	ci_upper
balanced_accuracy	0.59	0.54	0.64
false_negative_rate	0.72	0.64	0.81
false_positive_rate	0.09	0.04	0.15
informedness	0.19	0.08	0.29

RQ4: Are people aware that content can be Deepfaked before they take part in the study, and does this make them better at detecting them?

Percent of participants awareness of the concept prior to study

I.e., using the full sample and reporting the sample percentage.

Description of sample:

percent_aware <- data_after_exclusions %>%
  dplyr::select(deepfake_awareness_open_recoded) %>%
  drop_na() %>%
  count(deepfake_awareness_open_recoded) %>%
  mutate(counts = n,
         awareness = as.factor(deepfake_awareness_open_recoded),
         percent_aware = round(counts/sum(counts)*100, 1)) %>%
  filter(awareness == "TRUE") %>%
  dplyr::select(percent_aware) 

percent_aware %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

percent_aware
53.5

In the subset of participants who were shown a deepfake, did prior awareness make them more likely to detect it?

Putting aside true negatives and false positive, does prior awareness of the concept of Deepfaking at least make people better at detecting Deepfakes

It would of course be possible include data from both experiment_conditions and add it to the model, however interpreting the two and three way interactions is less intuitive. Given this question is of secondary importance, I we therefore elected for the simpler analysis focusing on awareness and the FNR/TPR.

Fit model

# convert data to counts
data_counts_awareness_detection <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked") %>%
  dplyr::select(experiment, deepfake_awareness_open_recoded, deepfake_detection_open_recoded) %>%
  drop_na() %>%
  count(experiment, deepfake_awareness_open_recoded, deepfake_detection_open_recoded) %>%
  group_by(experiment) %>%
  mutate(counts = n,
         awareness = as.factor(deepfake_awareness_open_recoded),
         detection = as.factor(deepfake_detection_open_recoded),
         proportion = counts/sum(counts)) %>%
  ungroup() %>%
  dplyr::select(experiment, awareness, detection, counts, proportion)

# total counts is needed later to convert to proportions
total_counts_awareness_detection <- data_counts_awareness_detection %>%
  group_by(experiment) %>%
  summarize(total = sum(counts)) 

# fit poisson model
fit_exploratory_poisson_awareness_detection <- 
  brm(formula = counts ~ 1 + awareness * detection + (1 | experiment),
      family  = poisson(),
      data    = data_counts_awareness_detection,
      file    = "models/fit_exploratory_poisson_awareness_detection",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.998,
                     max_treedepth = 18),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

pp_check(fit_exploratory_poisson_awareness_detection, nsamples = 100)

summary(fit_exploratory_poisson_awareness_detection)

##  Family: poisson 
##   Links: mu = log 
## Formula: counts ~ 1 + awareness * detection + (1 | experiment) 
##    Data: data_counts_awareness_detection (Number of observations: 8) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Group-Level Effects: 
## ~experiment (Number of levels: 2) 
##               Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept)     1.82      2.13     0.01     6.01 1.52        7       20
## 
## Population-Level Effects: 
##                             Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                       1.74      3.48    -4.55     5.01 1.58        7
## awarenessTRUE                   0.00      0.14    -0.28     0.30 1.09       62
## detectionTRUE                  -1.99      0.29    -2.54    -1.39 1.10       54
## awarenessTRUE:detectionTRUE     1.07      0.36     0.32     1.70 1.09       27
##                             Tail_ESS
## Intercept                         15
## awarenessTRUE                    597
## detectionTRUE                    787
## awarenessTRUE:detectionTRUE      924
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_exploratory_poisson_awareness_detection, ask = FALSE)

Check informativeness of prior

Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.

check_prior(fit_exploratory_poisson_awareness_detection) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	informative
b_awarenessTRUE	uninformative
b_detectionTRUE	uninformative
b_awarenessTRUE.detectionTRUE	uninformative

Interpret posteriors

sjPlot doesn’t behave well with these variable names for some reason. From top to bottom, the parameters are awareness, detection, and awareness*detection.

plot_model(fit_exploratory_poisson_awareness_detection) + xlab("Parameter")

# plot(conditional_effects(fit_exploratory_poisson_awareness_detection), ask = FALSE)

Parameter estimates

# posterior draws for parameters (for results table)
draws_awareness_detection <- posterior_samples(fit_exploratory_poisson_awareness_detection) %>%
  dplyr::select(awarenessTRUE = b_awarenessTRUE, 
                detectionTRUE = b_detectionTRUE, 
                interaction = `b_awarenessTRUE:detectionTRUE`) 

estimates_awareness_detection <- 
  full_join(as_tibble(map_estimate(draws_awareness_detection)),
            as_tibble(bayestestR::hdi(draws_awareness_detection, ci = .95)), 
          by = "Parameter") %>%
  # exponentiate the log IRR values to IRR
  mutate_if(is.numeric, exp) %>%
  full_join(draws_awareness_detection %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(exp(value) > 1)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  dplyr::select(Parameter, incidence_rate_ratio_MAP = MAP_Estimate, CI_95_lower = CI_low, CI_95_upper = CI_high, p) 
  # convert from odds to probability
  # mutate_if(is.numeric, function(x){x/(1+x)}) %>%
  
# table
estimates_awareness_detection %>%
  mutate_at(vars("incidence_rate_ratio_MAP", "CI_95_lower", "CI_95_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	incidence_rate_ratio_MAP	CI_95_lower	CI_95_upper	p
awarenessTRUE	0.91	0.77	1.36	0.4843214
detectionTRUE	0.12	0.08	0.25	0.0000000
interaction	3.83	1.37	5.47	0.0021429

# hypothesis testing
H4 <- ifelse((estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(CI_95_lower)) > 1, 
              "Accepted", "Rejected")

comparison_string_awareness_detection <-
  paste0("Individuals who were aware of the concept of Deepfakes prior to participating in the study were ",
         estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(incidence_rate_ratio_MAP) %>% round(1), 
         " times more likely to detect that they had been shown a deepfake than those who were not aware of the concept (Incidence Rate Ratio = ",
         estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(incidence_rate_ratio_MAP) %>% round(2), 
         ", 95% CI [",
         estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(CI_95_lower) %>% round(2),
         ", ",
         estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(CI_95_upper) %>% round(2),
         "])")

H4

Using the subset of participants who were in the Deepfake condition, we calculated counts for each of the combinations of the Deepfake concept check and Deepfake detection questions (e.g., awareness = TRUE & detection = TRUE, awareness = TRUE & detection = FALSE, etc.). We will then use a Bayesian Poisson model to estimate a 95% Credible Interval around the interaction effect’s Incidence Rate Ratio. A Credible Interval whose lower bound is > 1 will be considered evidence in support of this hypothesis. Estimated marginal predicted probabilities will also be reported.

• Result: Accepted
• Individuals who were aware of the concept of Deepfakes prior to participating in the study were 3.8 times more likely to detect that they had been shown a deepfake than those who were not aware of the concept (Incidence Rate Ratio = 3.83, 95% CI [1.37, 5.47])

Predicted probabilities

posterior_predictions_awareness_detection <-
  tibble(experiment = c("5", "6"),
         awareness = c("TRUE", "FALSE"),
         detection = c("TRUE", "FALSE")) %>%
  data_grid(experiment, awareness, detection) %>%
  add_predicted_draws(model = fit_exploratory_poisson_awareness_detection, re_formula = NULL) %>%
  rename(predicted_count = .prediction) %>%
  left_join(total_counts_awareness_detection, by = "experiment") %>%
  mutate(predicted_probabiity = predicted_count/total) %>%
  ungroup() %>%
  dplyr::select(experiment, awareness, detection, predicted_count, predicted_probabiity) 


posterior_predictions_awareness_detection_aT_dT <- posterior_predictions_awareness_detection %>% 
  filter(awareness == "TRUE" & detection == "TRUE")
posterior_predictions_awareness_detection_aT_dF <- posterior_predictions_awareness_detection %>% 
  filter(awareness == "TRUE" & detection == "FALSE")
posterior_predictions_awareness_detection_aF_dT <- posterior_predictions_awareness_detection %>% 
  filter(awareness == "FALSE" & detection == "TRUE")
posterior_predictions_awareness_detection_aF_dF <- posterior_predictions_awareness_detection %>% 
  filter(awareness == "FALSE" & detection == "FALSE")


results_detection_probabilities <- 
  rbind(
    bind_cols(as_tibble(map_estimate(posterior_predictions_awareness_detection_aT_dT$predicted_probabiity)),
              as_tibble(bayestestR::hdi(posterior_predictions_awareness_detection_aT_dT$predicted_probabiity, 
                                        ci = .95))) %>%
      mutate(awareness = "TRUE", detection = "TRUE"),
    bind_cols(as_tibble(map_estimate(posterior_predictions_awareness_detection_aT_dF$predicted_probabiity)),
              as_tibble(bayestestR::hdi(posterior_predictions_awareness_detection_aT_dF$predicted_probabiity, 
                                        ci = .95))) %>%
      mutate(awareness = "TRUE", detection = "FALSE"),
    bind_cols(as_tibble(map_estimate(posterior_predictions_awareness_detection_aF_dT$predicted_probabiity)),
              as_tibble(bayestestR::hdi(posterior_predictions_awareness_detection_aF_dT$predicted_probabiity, 
                                        ci = .95))) %>%
      mutate(awareness = "FALSE", detection = "TRUE"),
    bind_cols(as_tibble(map_estimate(posterior_predictions_awareness_detection_aF_dF$predicted_probabiity)),
              as_tibble(bayestestR::hdi(posterior_predictions_awareness_detection_aF_dF$predicted_probabiity, 
                                        ci = .95))) %>%
      mutate(awareness = "FALSE", detection = "FALSE")
  ) %>%
  dplyr::select(awareness, detection, detection_probability_MAP = value, 
                CI_95_lower = CI_low, CI_95_upper = CI_high) %>%
  mutate_if(is.numeric, round, digits = 3) 

results_detection_probabilities %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

awareness	detection	detection_probability_MAP	CI_95_lower	CI_95_upper
TRUE	TRUE	0.136	0.077	0.260
TRUE	FALSE	0.380	0.240	0.538
FALSE	TRUE	0.039	0.010	0.107
FALSE	FALSE	0.383	0.240	0.538

• Probability of detecting deepfake if unaware: 0.039
• Probability of detecting deepfake if aware: 0.136

RQ5: Does prior awareness of the concept of Deepfakes make people immune to their influence?

Subset who received deepfaked videos and were aware of the concept prior to the experiment. Same Bayesian multilevel models as employed above, using only source_valence as IV, i.e., to detect whether learning effects are credibly non-zero in this subset.

Sample sizes

data_aware_subset_n <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked" & !is.na(deepfake_awareness_open_recoded)) %>%
  count(deepfake_awareness_open_recoded) %>%
  mutate(proportion = round(n/sum(n), 2)) %>%
  arrange(desc(proportion))

data_aware_subset_n %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

deepfake_awareness_open_recoded	n	proportion
TRUE	114	0.55
FALSE	93	0.45

data_aware_subset <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked" & deepfake_awareness_open_recoded == TRUE)

Self-reported evaluations

Fit model

fit_exploratory_selfreport_deepfaked_aware <-
  brm(formula = mean_self_reported_evaluation ~ source_valence + (1 | experiment),
      family  = gaussian(),
      data    = data_aware_subset,
      file    = "models/fit_exploratory_selfreport_deepfaked_aware",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_exploratory_selfreport_deepfaked_aware)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_self_reported_evaluation ~ source_valence + (1 | experiment) 
##    Data: data_aware_subset (Number of observations: 114) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Group-Level Effects: 
## ~experiment (Number of levels: 2) 
##               Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept)     0.79      1.03     0.01     3.68 1.00     4367     5691
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -1.59      0.70    -3.10    -0.02 1.00     5130
## source_valencepositive     3.07      0.21     2.67     3.48 1.00    16036
##                        Tail_ESS
## Intercept                  3882
## source_valencepositive    15729
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.07      0.07     0.94     1.23 1.00    13710     8240
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_exploratory_selfreport_deepfaked_aware, ask = FALSE)

Check informativeness of prior

Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.

check_prior(fit_exploratory_selfreport_deepfaked_aware) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_exploratory_selfreport_deepfaked_aware)
plot_model(fit_exploratory_selfreport_deepfaked_aware, type = "pred", terms = "source_valence")

# results table
draws_sr_deepfaked_aware <-
  select(spread_draws(fit_exploratory_selfreport_deepfaked_aware, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_aware = b_source_valencepositive)

estimates_sr_deepfaked_aware <-
  map_estimate(draws_sr_deepfaked_aware) %>%
  full_join(bayestestR::hdi(draws_sr_deepfaked_aware, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_sr_deepfaked_aware, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_sr_deepfaked_aware %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p) 

bind_rows(filter(estimates_sr, Parameter %in% c("effect_deepfaked")),
          estimates_sr_deepfaked_aware) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	2.71	2.53	2.88	2.57	2.86	0
effect_deepfaked_aware	3.08	2.66	3.48	2.73	3.41	0

# hypothesis testing
H5a <- ifelse((estimates_sr_deepfaked_aware %>% filter(Parameter == "effect_deepfaked_aware") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H5a

In the subset of participants who were shown a Deepfaked video and reported being aware of the concept of Deepfaking prior to participating in the experiment, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ self-reported evaluations.

• Result: Accepted

Implicit

Fit model

fit_exploratory_implicit_deepfaked_aware <-
  brm(formula = IAT_D2 ~ source_valence + (1 | experiment),
      family  = gaussian(),
      data    = data_aware_subset,
      file    = "models/fit_exploratory_implicit_deepfaked_aware",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_exploratory_implicit_deepfaked_aware)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: IAT_D2 ~ source_valence + (1 | experiment) 
##    Data: data_aware_subset (Number of observations: 114) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Group-Level Effects: 
## ~experiment (Number of levels: 2) 
##               Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept)     0.74      1.01     0.01     3.43 1.00     4854     7905
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -0.08      0.65    -1.53     1.33 1.00     7124
## source_valencepositive     1.39      0.19     1.03     1.76 1.00    16343
##                        Tail_ESS
## Intercept                  6237
## source_valencepositive    15800
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     0.99      0.07     0.87     1.13 1.00    15629    14108
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_exploratory_implicit_deepfaked_aware, ask = FALSE)

Check informativeness of prior

Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.

check_prior(fit_exploratory_implicit_deepfaked_aware) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_exploratory_implicit_deepfaked_aware)
plot_model(fit_exploratory_implicit_deepfaked_aware, type = "pred", terms = "source_valence")

# results table
draws_imp_deepfaked_aware <-
  select(spread_draws(fit_exploratory_implicit_deepfaked_aware, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_aware = b_source_valencepositive)

estimates_imp_deepfaked_aware <-
  map_estimate(draws_imp_deepfaked_aware) %>%
  full_join(bayestestR::hdi(draws_imp_deepfaked_aware, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_imp_deepfaked_aware, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_imp_deepfaked_aware %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p) 

bind_rows(filter(estimates_imp, Parameter %in% c("effect_deepfaked")),
          estimates_imp_deepfaked_aware) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	1.32	1.16	1.49	1.18	1.47	0
effect_deepfaked_aware	1.40	1.01	1.74	1.09	1.70	0

# hypothesis testing
H5b <- ifelse((estimates_imp_deepfaked_aware %>% filter(Parameter == "effect_deepfaked_aware") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H5b

In the subset of participants who were shown a Deepfaked video and reported being aware of the concept of Deepfaking prior to participating in the experiment, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ IAT D2 scores.

• Result: Accepted

Behavioural intentions

Fit model

fit_exploratory_intentions_deepfaked_aware <-
  brm(formula = mean_intentions ~ source_valence, # no random effect for experiment as only exp 6 assessed intentions
      family  = gaussian(),
      data    = data_aware_subset,
      file    = "models/fit_exploratory_intentions_deepfaked_aware",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_exploratory_intentions_deepfaked_aware)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_intentions ~ source_valence 
##    Data: data_aware_subset (Number of observations: 53) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -3.31      0.22    -3.75    -2.87 1.00    19478
## source_valencepositive     3.09      0.29     2.52     3.67 1.00    19681
##                        Tail_ESS
## Intercept                 16588
## source_valencepositive    16773
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.04      0.11     0.86     1.27 1.00    19803    17063
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_exploratory_intentions_deepfaked_aware, ask = FALSE)

Check informativeness of prior

Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.

check_prior(fit_exploratory_intentions_deepfaked_aware) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_exploratory_intentions_deepfaked_aware)
plot_model(fit_exploratory_intentions_deepfaked_aware, type = "pred", terms = "source_valence")

# results table
draws_intentions_deepfaked_aware <-
  select(spread_draws(fit_exploratory_intentions_deepfaked_aware, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_aware = b_source_valencepositive)

estimates_intentions_deepfaked_aware <-
  map_estimate(draws_intentions_deepfaked_aware) %>%
  full_join(bayestestR::hdi(draws_intentions_deepfaked_aware, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_intentions_deepfaked_aware, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_intentions_deepfaked_aware %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p)

bind_rows(filter(estimates_intentions, Parameter %in% c("effect_deepfaked")),
          estimates_intentions_deepfaked_aware) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	3.08	2.69	3.46	2.76	3.40	0
effect_deepfaked_aware	3.09	2.52	3.67	2.60	3.56	0

# hypothesis testing
H5c <- ifelse((estimates_intentions_deepfaked_aware %>% filter(Parameter == "effect_deepfaked_aware") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H5c

In the subset of participants who were shown a Deepfaked video and reported being aware of the concept of Deepfaking prior to participating in the experiment, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ behavioral intention scores.

• Result: Accepted

RQ6: Does detecting that one was exposed to a Deepfake make people immune to its influence?

Subset who received deepfaked videos but also detected them. Same Bayesian multilevel models as employed above, using only source_valence as IV, i.e., to detect whether learning effects are credibly non-zero in this subset.

Sample sizes

data_detectors_subset_n <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked" & !is.na(deepfake_detection_open_recoded)) %>%
  count(deepfake_detection_open_recoded) %>%
  mutate(proportion = round(n/sum(n), 2)) %>%
  arrange(desc(proportion))

data_detectors_subset_n %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

deepfake_detection_open_recoded	n	proportion
FALSE	273	0.73
TRUE	99	0.27

data_detectors_subset <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked" & deepfake_detection_open_recoded == TRUE)

Self-reported evaluations

Fit model

fit_exploratory_selfreport_deepfaked_detected <-
  brm(formula = mean_self_reported_evaluation ~ source_valence + (1 | experiment),
      family  = gaussian(),
      data    = data_detectors_subset,
      file    = "models/fit_exploratory_selfreport_deepfaked_detected",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_exploratory_selfreport_deepfaked_detected)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_self_reported_evaluation ~ source_valence + (1 | experiment) 
##    Data: data_detectors_subset (Number of observations: 99) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Group-Level Effects: 
## ~experiment (Number of levels: 3) 
##               Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept)     0.43      0.55     0.01     1.94 1.00     4415     7248
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -1.60      0.38    -2.39    -0.84 1.00     6614
## source_valencepositive     2.75      0.24     2.28     3.21 1.00    18013
##                        Tail_ESS
## Intercept                  5394
## source_valencepositive    17433
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.17      0.09     1.02     1.36 1.00    17540    16567
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_exploratory_selfreport_deepfaked_detected, ask = FALSE)

Check informativeness of prior

Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.

check_prior(fit_exploratory_selfreport_deepfaked_detected) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_exploratory_selfreport_deepfaked_detected)
plot_model(fit_exploratory_selfreport_deepfaked_detected, type = "pred", terms = "source_valence")

# results table
draws_sr_deepfaked_detected <-
  select(spread_draws(fit_exploratory_selfreport_deepfaked_detected, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_detected = b_source_valencepositive)

estimates_sr_deepfaked_detected <-
  map_estimate(draws_sr_deepfaked_detected) %>%
  full_join(bayestestR::hdi(draws_sr_deepfaked_detected, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_sr_deepfaked_detected, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_sr_deepfaked_detected %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p) 

bind_rows(filter(estimates_sr, Parameter %in% c("effect_deepfaked")),
          estimates_sr_deepfaked_detected) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	2.71	2.53	2.88	2.57	2.86	0
effect_deepfaked_detected	2.72	2.30	3.23	2.37	3.15	0

# hypothesis testing
H6a <- ifelse((estimates_sr_deepfaked_detected %>% filter(Parameter == "effect_deepfaked_detected") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H6a

In the subset of participants who were shown a Deepfaked video and accurately detected that the video was Deepfaked, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ self-reported evaluations.

• Result: Accepted

Implicit

Fit model

fit_exploratory_implicit_deepfaked_detected <-
  brm(formula = IAT_D2 ~ source_valence + (1 | experiment),
      family  = gaussian(),
      data    = data_detectors_subset,
      file    = "models/fit_exploratory_implicit_deepfaked_detected",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_exploratory_implicit_deepfaked_detected)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: IAT_D2 ~ source_valence + (1 | experiment) 
##    Data: data_detectors_subset (Number of observations: 99) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Group-Level Effects: 
## ~experiment (Number of levels: 3) 
##               Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept)     1.06      0.88     0.25     3.31 1.00     5745     8052
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                  0.06      0.68    -1.34     1.47 1.00     6784
## source_valencepositive     1.06      0.19     0.70     1.43 1.00    16138
##                        Tail_ESS
## Intercept                  5738
## source_valencepositive    14822
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     0.91      0.07     0.79     1.05 1.00    16803    15403
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_exploratory_implicit_deepfaked_detected, ask = FALSE)

Check informativeness of prior

Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.

check_prior(fit_exploratory_implicit_deepfaked_detected) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_exploratory_implicit_deepfaked_detected)
plot_model(fit_exploratory_implicit_deepfaked_detected, type = "pred", terms = "source_valence")

# results table
draws_imp_deepfaked_detected <-
  select(spread_draws(fit_exploratory_implicit_deepfaked_detected, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_detected = b_source_valencepositive)

estimates_imp_deepfaked_detected <-
  map_estimate(draws_imp_deepfaked_detected) %>%
  full_join(bayestestR::hdi(draws_imp_deepfaked_detected, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_imp_deepfaked_detected, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_imp_deepfaked_detected %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p) 

bind_rows(filter(estimates_imp, Parameter %in% c("effect_deepfaked")),
          estimates_imp_deepfaked_detected) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	1.32	1.16	1.49	1.18	1.47	0
effect_deepfaked_detected	1.06	0.69	1.42	0.76	1.38	0

# hypothesis testing
H6b <- ifelse((estimates_imp_deepfaked_detected %>% filter(Parameter == "effect_deepfaked_detected") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H6b

In the subset of participants who were shown a Deepfaked video and accurately detected that the video was Deepfaked, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ IAT D2 scores.

• Result: Accepted

Behavioural intentions

Fit model

fit_exploratory_intentions_deepfaked_detected <-
  brm(formula = mean_intentions ~ source_valence, # no random effect for experiment as only exp 6 assessed intentions
      family  = gaussian(),
      data    = data_detectors_subset,
      file    = "models/fit_exploratory_intentions_deepfaked_detected",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_exploratory_intentions_deepfaked_detected)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_intentions ~ source_valence 
##    Data: data_detectors_subset (Number of observations: 24) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -3.27      0.26    -3.80    -2.75 1.00    19532
## source_valencepositive     2.72      0.41     1.90     3.53 1.00    19075
##                        Tail_ESS
## Intercept                 16362
## source_valencepositive    16078
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     0.99      0.16     0.74     1.36 1.00    16025    17060
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_exploratory_intentions_deepfaked_detected, ask = FALSE)

Check informativeness of prior

Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.

check_prior(fit_exploratory_intentions_deepfaked_detected) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_exploratory_intentions_deepfaked_detected)
plot_model(fit_exploratory_intentions_deepfaked_detected, type = "pred", terms = "source_valence")

# results table
draws_intentions_deepfaked_detected <-
  select(spread_draws(fit_exploratory_intentions_deepfaked_detected, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_detected = b_source_valencepositive)

estimates_intentions_deepfaked_detected <-
  map_estimate(draws_intentions_deepfaked_detected) %>%
  full_join(bayestestR::hdi(draws_intentions_deepfaked_detected, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_intentions_deepfaked_detected, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_intentions_deepfaked_detected %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p)

bind_rows(filter(estimates_intentions, Parameter %in% c("effect_deepfaked")),
          estimates_intentions_deepfaked_detected) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	3.08	2.69	3.46	2.76	3.40	0
effect_deepfaked_detected	2.72	1.90	3.53	2.02	3.37	0

# hypothesis testing
H6c <- ifelse((estimates_intentions_deepfaked_detected %>% filter(Parameter == "effect_deepfaked_detected") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H6c

In the subset of participants who were shown a Deepfaked video and accurately detected that the video was Deepfaked, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ behavioral intention scores.

• Result: Accepted

RQ7: Does being both aware of the concept of Deepfaking before the study and correcting detecting that content is Deepfaked make you immune to its influence?

Subset who received deepfaked videos, were aware of the concept before the study, and also detected them. Same Bayesian multilevel models as employed above, using only source_valence as IV, i.e., to detect whether learning effects are credibly non-zero in this subset.

Sample sizes

data_aware_detectors_subset_n <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked" & 
           !is.na(deepfake_detection_open_recoded) & 
           !is.na(deepfake_awareness_open_recoded)) %>%
  count(deepfake_detection_open_recoded, deepfake_awareness_open_recoded) %>%
  mutate(proportion = round(n/sum(n), 2)) %>%
  arrange(desc(proportion))

data_aware_detectors_subset_n %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

deepfake_detection_open_recoded	deepfake_awareness_open_recoded	n	proportion
FALSE	TRUE	82	0.40
FALSE	FALSE	81	0.39
TRUE	TRUE	32	0.15
TRUE	FALSE	12	0.06

data_aware_detectors_subset <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked" & deepfake_detection_open_recoded == TRUE & deepfake_awareness_open_recoded == TRUE)

Self-reported evaluations

Fit model

fit_exploratory_selfreport_deepfaked_aware_detected <-
  brm(formula = mean_self_reported_evaluation ~ source_valence + (1 | experiment),
      family  = gaussian(),
      data    = data_aware_detectors_subset,
      file    = "models/fit_exploratory_selfreport_deepfaked_aware_detected",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_exploratory_selfreport_deepfaked_aware_detected)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_self_reported_evaluation ~ source_valence + (1 | experiment) 
##    Data: data_aware_detectors_subset (Number of observations: 32) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Group-Level Effects: 
## ~experiment (Number of levels: 2) 
##               Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept)     0.93      1.07     0.02     3.90 1.00     6435    10705
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -1.66      0.80    -3.37     0.02 1.00     8207
## source_valencepositive     3.26      0.48     2.31     4.22 1.00    17817
##                        Tail_ESS
## Intercept                  7798
## source_valencepositive    15747
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.34      0.18     1.04     1.76 1.00    17093    15054
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_exploratory_selfreport_deepfaked_aware_detected, ask = FALSE)

Check informativeness of prior

Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.

check_prior(fit_exploratory_selfreport_deepfaked_aware_detected) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_exploratory_selfreport_deepfaked_aware_detected)
plot_model(fit_exploratory_selfreport_deepfaked_aware_detected, type = "pred", terms = "source_valence")

# results table
draws_sr_deepfaked_aware_detected <-
  select(spread_draws(fit_exploratory_selfreport_deepfaked_aware_detected, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_aware_detected = b_source_valencepositive)

estimates_sr_deepfaked_aware_detected <-
  map_estimate(draws_sr_deepfaked_aware_detected) %>%
  full_join(bayestestR::hdi(draws_sr_deepfaked_aware_detected, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_sr_deepfaked_aware_detected, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_sr_deepfaked_aware_detected %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p) 

bind_rows(filter(estimates_sr, Parameter %in% c("effect_deepfaked")),
          estimates_sr_deepfaked_aware_detected) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	2.71	2.53	2.88	2.57	2.86	0
effect_deepfaked_aware_detected	3.28	2.32	4.23	2.47	4.06	0

# hypothesis testing
H7a <- ifelse((estimates_sr_deepfaked_aware_detected %>% filter(Parameter == "effect_deepfaked_aware_detected") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H7a

In the subset of participants who were shown a Deepfaked video, reported being aware of the concept of Deepfakes, and accurately detected that the video was Deepfaked, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ self-reported evaluations.

• Result: Accepted

Implicit

Fit model

fit_exploratory_implicit_deepfaked_aware_detected <-
  brm(formula = IAT_D2 ~ source_valence + (1 | experiment),
      family  = gaussian(),
      data    = data_aware_detectors_subset,
      file    = "models/fit_exploratory_implicit_deepfaked_aware_detected",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_exploratory_implicit_deepfaked_aware_detected)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: IAT_D2 ~ source_valence + (1 | experiment) 
##    Data: data_aware_detectors_subset (Number of observations: 32) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Group-Level Effects: 
## ~experiment (Number of levels: 2) 
##               Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sd(Intercept)     1.33      1.22     0.12     4.54 1.00     6167     6226
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -0.21      0.96    -2.27     1.80 1.00     8621
## source_valencepositive     1.23      0.34     0.56     1.89 1.00    15672
##                        Tail_ESS
## Intercept                  9314
## source_valencepositive    14602
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     0.94      0.13     0.73     1.24 1.00    14762    14675
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_exploratory_implicit_deepfaked_aware_detected, ask = FALSE)

Check informativeness of prior

Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.

check_prior(fit_exploratory_implicit_deepfaked_aware_detected) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_exploratory_implicit_deepfaked_aware_detected)
plot_model(fit_exploratory_implicit_deepfaked_aware_detected, type = "pred", terms = "source_valence")

# results table
draws_imp_deepfaked_aware_detected <-
  select(spread_draws(fit_exploratory_implicit_deepfaked_aware_detected, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_aware_detected = b_source_valencepositive)

estimates_imp_deepfaked_aware_detected <-
  map_estimate(draws_imp_deepfaked_aware_detected) %>%
  full_join(bayestestR::hdi(draws_imp_deepfaked_aware_detected, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_imp_deepfaked_aware_detected, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_imp_deepfaked_aware_detected %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p) 

bind_rows(filter(estimates_imp, Parameter %in% c("effect_deepfaked")),
          estimates_imp_deepfaked_aware_detected) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	1.32	1.16	1.49	1.18	1.47	0.0000000
effect_deepfaked_aware_detected	1.23	0.58	1.91	0.67	1.77	0.0004643

# hypothesis testing
H7b <- ifelse((estimates_imp_deepfaked_aware_detected %>% filter(Parameter == "effect_deepfaked_aware_detected") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H7b

In the subset of participants who were shown a Deepfaked video, reported being aware of the concept of Deepfakes, and accurately detected that the video was Deepfaked, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ IAT D2 scores.

• Result: Accepted

Behavioural intentions

Fit model

fit_exploratory_intentions_deepfaked_aware_detected <-
  brm(formula = mean_intentions ~ source_valence, # no random effect for experiment as only exp 6 assessed intentions
      family  = gaussian(),
      data    = data_aware_detectors_subset,
      file    = "models/fit_exploratory_intentions_deepfaked_aware_detected",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_exploratory_intentions_deepfaked_aware_detected)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_intentions ~ source_valence 
##    Data: data_aware_detectors_subset (Number of observations: 17) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -3.15      0.37    -3.86    -2.42 1.00    18470
## source_valencepositive     2.45      0.53     1.39     3.50 1.00    18362
##                        Tail_ESS
## Intercept                 14873
## source_valencepositive    14965
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.08      0.22     0.75     1.60 1.00    15396    14883
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_exploratory_intentions_deepfaked_aware_detected, ask = FALSE)

Check informativeness of prior

Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.

check_prior(fit_exploratory_intentions_deepfaked_aware_detected) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_exploratory_intentions_deepfaked_aware_detected)
plot_model(fit_exploratory_intentions_deepfaked_aware_detected, type = "pred", terms = "source_valence")

# results table
draws_intentions_deepfaked_aware_detected <-
  select(spread_draws(fit_exploratory_intentions_deepfaked_aware_detected, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_aware_detected = b_source_valencepositive)

estimates_intentions_deepfaked_aware_detected <-
  map_estimate(draws_intentions_deepfaked_aware_detected) %>%
  full_join(bayestestR::hdi(draws_intentions_deepfaked_aware_detected, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_intentions_deepfaked_aware_detected, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_intentions_deepfaked_aware_detected %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p)

bind_rows(filter(estimates_intentions, Parameter %in% c("effect_deepfaked")),
          estimates_intentions_deepfaked_aware_detected) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	3.08	2.69	3.46	2.76	3.40	0
effect_deepfaked_aware_detected	2.47	1.43	3.53	1.59	3.32	0

# hypothesis testing
H7c <- ifelse((estimates_intentions_deepfaked_aware_detected %>% filter(Parameter == "effect_deepfaked_aware_detected") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H7c

In the subset of participants who were shown a Deepfaked video, reported being aware of the concept of Deepfakes, and accurately detected that the video was Deepfaked, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ behavioral intention scores.

• Result: Accepted

Summary of hypothesis tests

H1: Establishing first impressions via online video content

• Genuine content can establish self-reported evaluations (Accepted), implicit evaluations (Accepted), and behavioural intentions (Accepted).
• Deepfaked content can establish self-reported evaluations (Accepted), implicit evaluations (Accepted), and behavioural intentions (Accepted).

H2: Are deepfakes just as good as the real thing?

• Deepfakes are non-inferior to genuine content on self-reported evaluations (Accepted), implicit evaluations (Rejected), and behavioural intentions (Accepted).

H3: How good are people at detecting whether content is genuine or Deepfaked?

Whole sample

classifications %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)

variable	observed	ci_lower	ci_upper
balanced_accuracy	0.59	0.56	0.62
false_negative_rate	0.73	0.69	0.78
false_positive_rate	0.08	0.04	0.12
informedness	0.19	0.13	0.25

Those who were aware of the concept prior to the study

classifications_subset %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)

variable	observed	ci_lower	ci_upper
balanced_accuracy	0.59	0.54	0.64
false_negative_rate	0.72	0.64	0.81
false_positive_rate	0.09	0.04	0.15
informedness	0.19	0.08	0.29

H4: Does prior awareness of the concept of Deepfakes make people better at detecting them?

• Percent aware of the concept of Deepfakes: 53.5
• Of those exposed to a Deepfake, Individuals who were aware of the concept of Deepfakes prior to participating in the study were 3.8 times more likely to detect that they had been shown a deepfake than those who were not aware of the concept (Incidence Rate Ratio = 3.83, 95% CI [1.37, 5.47]), Accepted.

H5-7: Does being aware of the concept, detecitng the deepfake, or both make you immune to a Deepfake?

• H5: Evaluative learning effects found in the subset who were shown Deepfakes and were aware of the concept, on self-reports (Accepted), implicit measure (Accepted) and behavioural intentions (Accepted).
• H6: Evaluative learning effects found in the subset who were shown Deepfakes and detected them, on self-reports (Accepted), implicit measure (Accepted) and behavioural intentions (Accepted).
• H6: Evaluative learning effects found in the subset who were shown Deepfakes, were aware of the concept, and detected them, on self-reports (Accepted), implicit measure (Accepted) and behavioural intentions (Accepted).

Session Info

sessionInfo()

## R version 4.0.2 (2020-06-22)
## Platform: x86_64-apple-darwin17.0 (64-bit)
## Running under: macOS  10.16
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRblas.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRlapack.dylib
## 
## locale:
## [1] en_IE.UTF-8/en_IE.UTF-8/en_IE.UTF-8/C/en_IE.UTF-8/en_IE.UTF-8
## 
## attached base packages:
## [1] parallel  stats     graphics  grDevices utils     datasets  methods  
## [8] base     
## 
## other attached packages:
##  [1] e1071_1.7-3      caret_6.0-86     lattice_0.20-41  furrr_0.2.1     
##  [5] future_1.19.1    modelr_0.1.8     semTools_0.5-3   lavaan_0.6-7    
##  [9] IATscores_0.2.7  broom_0.7.2      rsample_0.0.7    psych_2.0.9     
## [13] sjPlot_2.8.4     bayestestR_0.7.5 tidybayes_2.0.3  brms_2.14.0     
## [17] Rcpp_1.0.5       kableExtra_1.3.1 knitr_1.30       forcats_0.5.0   
## [21] stringr_1.4.0    dplyr_1.0.2      purrr_0.3.4      readr_1.3.1     
## [25] tidyr_1.1.2      tibble_3.0.4     ggplot2_3.3.2    tidyverse_1.3.0 
## 
## loaded via a namespace (and not attached):
##   [1] tidyselect_1.1.0     lme4_1.1-25          htmlwidgets_1.5.1   
##   [4] grid_4.0.2           pROC_1.16.2          munsell_0.5.0       
##   [7] codetools_0.2-16     effectsize_0.4.0     statmod_1.4.34      
##  [10] DT_0.13              miniUI_0.1.1.1       withr_2.3.0         
##  [13] Brobdingnag_1.2-6    colorspace_2.0-0     highr_0.8           
##  [16] rstudioapi_0.13      stats4_4.0.2         bayesplot_1.7.2     
##  [19] listenv_0.8.0        labeling_0.4.2       huge_1.3.4.1        
##  [22] emmeans_1.4.6        rstan_2.21.2         mnormt_1.5-7        
##  [25] farver_2.0.3         bridgesampling_1.0-0 coda_0.19-3         
##  [28] vctrs_0.3.5          generics_0.0.2       TH.data_1.0-10      
##  [31] ipred_0.9-9          xfun_0.19            R6_2.5.0            
##  [34] markdown_1.1         assertthat_0.2.1     promises_1.1.0      
##  [37] scales_1.1.1         multcomp_1.4-13      nnet_7.3-14         
##  [40] gtable_0.3.0         globals_0.13.1       processx_3.4.4      
##  [43] sandwich_2.5-1       timeDate_3043.102    rlang_0.4.8         
##  [46] splines_4.0.2        ModelMetrics_1.2.2.2 checkmate_2.0.0     
##  [49] inline_0.3.16        yaml_2.2.1           reshape2_1.4.4      
##  [52] abind_1.4-5          d3Network_0.5.2.1    threejs_0.3.3       
##  [55] crosstalk_1.1.0.1    backports_1.1.9      httpuv_1.5.2        
##  [58] rsconnect_0.8.16     Hmisc_4.4-1          lava_1.6.7          
##  [61] tools_4.0.2          ellipsis_0.3.1       RColorBrewer_1.1-2  
##  [64] ggridges_0.5.2       plyr_1.8.6           base64enc_0.1-3     
##  [67] ps_1.4.0             prettyunits_1.1.1    rpart_4.1-15        
##  [70] pbapply_1.4-2        zoo_1.8-8            qgraph_1.6.5        
##  [73] haven_2.3.1          cluster_2.1.0        fs_1.4.1            
##  [76] magrittr_2.0.1       data.table_1.13.2    colourpicker_1.0    
##  [79] reprex_0.3.0         mvtnorm_1.1-1        whisker_0.4         
##  [82] sjmisc_2.8.5         matrixStats_0.56.0   hms_0.5.3           
##  [85] shinyjs_1.1          mime_0.9             evaluate_0.14       
##  [88] arrayhelpers_1.1-0   xtable_1.8-4         shinystan_2.5.0     
##  [91] sjstats_0.18.0       jpeg_0.1-8.1         readxl_1.3.1        
##  [94] gridExtra_2.3        ggeffects_0.14.3     rstantools_2.1.1    
##  [97] compiler_4.0.2       V8_3.2.0             crayon_1.3.4        
## [100] minqa_1.2.4          StanHeaders_2.21.0-6 htmltools_0.5.0     
## [103] corpcor_1.6.9        later_1.0.0          Formula_1.2-3       
## [106] RcppParallel_5.0.2   lubridate_1.7.9      DBI_1.1.0           
## [109] sjlabelled_1.1.7     dbplyr_1.4.3         MASS_7.3-53         
## [112] boot_1.3-25          Matrix_1.2-18        cli_2.1.0           
## [115] gower_0.2.2          insight_0.10.0       igraph_1.2.5        
## [118] BDgraph_2.62         pkgconfig_2.0.3      foreign_0.8-80      
## [121] recipes_0.1.13       foreach_1.5.0        xml2_1.3.2          
## [124] svUnit_1.0.3         pbivnorm_0.6.0       dygraphs_1.1.1.6    
## [127] webshot_0.5.2        prodlim_2019.11.13   estimability_1.3    
## [130] rvest_0.3.5          snakecase_0.11.0     callr_3.5.1         
## [133] digest_0.6.27        parameters_0.8.6     rmarkdown_2.5       
## [136] cellranger_1.1.0     htmlTable_1.13.3     curl_4.3            
## [139] shiny_1.5.0          gtools_3.8.2         rjson_0.2.20        
## [142] nloptr_1.2.2.2       glasso_1.11          lifecycle_0.2.0     
## [145] nlme_3.1-148         jsonlite_1.7.1       viridisLite_0.3.0   
## [148] fansi_0.4.1          pillar_1.4.6         loo_2.3.1           
## [151] fastmap_1.0.1        httr_1.4.1           pkgbuild_1.1.0      
## [154] survival_3.1-12      glue_1.4.2           xts_0.12-0          
## [157] fdrtool_1.2.15       iterators_1.0.12     png_0.1-7           
## [160] shinythemes_1.1.2    class_7.3-17         stringi_1.4.6       
## [163] performance_0.4.6    latticeExtra_0.6-29